00100			THE LISP70 PATTERN MATCHER
00200	
00300	SOURCE
00400		The list (or file or string or list&file) that is scanned by the
00500	pattern matcher.  It is a DYNAMIC PUBLIC STREAM VARIABLE.
00600	
00700	(BIND SOURCE X1 ... XN)
00800		Pushes down the old SOURCE and replaces it by ⊂X1...XN⊃.
00900	
01000	(UNBIND SOURCE X1 ... XN)
01100		Fails unless SOURCE = ⊂X1 ... XN⊃.  If
01200	it succeeds, then it restores the former binding of SOURCE.
01300	
01400	(TOKEN)
01500		Removes and returns the first token from SOURCE. (Fails if ATOM SOURCE).
01600	
01700	(TOKENS M)
01800		Removes and returns a STREAM of the first M tokens from SOURCE.
01900	
02000	(POP F X1...XN)
02100		If F is a function of N+M arguments (M>0), this is equivalent to:
02200			(F X1 ... XN (TOKENS M))
02300	Example:
02400			(POP STORE X)
02500	This pops the first token off SOURCE into X.
02600	
02700	(MATCH F X1...XN)
02800		Same as POP, but if the result is NIL, then MATCH fails.  Example:
02900			(MATCH EQ (QUOTE A))
03000	This removes the first token and fails if it is not A.
03100	
03200	(PARSE F X1...XN)
03300		Same as POP, but the result of F is prefixed to SOURCE.  Example:
03400			(PARSE SUBST)
03500	This replaces the first two tokens by SUBST(first token, second token).
03600	
03700	(LONGEST)
03800		choose(tokens(length(source)), ... , tokens(0))
03900	
04000	(SHORTEST)
04100		choose(tokens(0), ... , tokens(length(source)))
04200	
04300	(POP M TOKENS F X1...XN)
04400		Specifies M for an F that has a variable number of arguments.
04500	
04600	(POP LONGEST F X1...XN)
04700		Tries M=LENGTH(SOURCE) by -1 to 0.
04800	
04900	(POP SHORTEST F X1...XN)
05000		Tries M=0 by 1 to LENGTH(SOURCE).
05100	
05200	(MATCH M TOKENS GREATERP), (PARSE LONGEST EXPRESSION), (POP SHORTEST LIST)
     

00100	(REWRITE <dec> <rec> <list>)
00200		Decomposes <list> according to <dec>.
00300		If successful, return <rec>.
00400		If unsuccessful, fail.
00500	
00600	Extendable functions have no private variables of their own.  Every
00700	colon variable in a <dec> or <rec> is private in its REWRITE.  In
00800	Unextendable functions, colon variables are accessed free from the
00900	rewrite.
01000	
01100	:X		In Extendable Function		Otherwise
01200		first:	     (POP SETC X)	      (POP SETQ X)
01300		then:	    (MATCH EQUAL X)	     (MATCH EQUAL X)
01400	$X	(MATCH EQUAL X)
01500	%X	first time: (POP BIND PUBLIC CONTEXTUAL X)  then: (MATCH EQUAL X)
01600	
01700	(POP LAMBDA (X Y) (FOO Y X)) is like Hewitt's KAPPA.  
01800		But we have a choice of POP, MATCH, or PARSE.
01900	
02000	(DECOMPOSE <dec> <list>)
02100		Decomposes <list> according to <dec>.
02200		If successful, returns T.
02300		If unsuccessful, returns NIL.
02400	
02500	[OPT <dec>] = [ALT <dec>|]
02600	[REP <dec>] = [ALT <>|<dec>|<dec><dec>|...]
02700	[STAR <dec>] = [ALT <dec>...<dec>|...|<dec><dec>|<dec>|<>]
02800	[ALT :X | :Y | :Z] sets X, Y, and Z no matter which ALT is selected.
02900	[ALTNUM :N <dec1>|<dec2>|...] sets :N to the no. of the alternative chosen.
03000		The unselected ones are set to ⊂⊃. :N is set to the case no. that worked.
03100	
03200	(EXTENDABLE <factored rules>)
03300		The body of an extendable function, i.e.,
03400	    (DEFPROP FOO (LAMBDA SOURCE (EXTENDABLE ...)) XEXPR)
03500	
03600	(DECATOMS (A1 D1) (A2 D2) ...) is a macro that expands to:
03700		(ALT (PROGN (MATCH EQ @A1) D1) (PROGN (MATCH EQ @A2) D2) ... )
03800	
03900	(DECOMPOSE (PARSE LONGEST EXPRESSION) FOO)
04000		Finds the leftmost longest expression in FOO and does not change FOO.
04100	
04200	(DETACH (PARSE LONGEST EXPRESSION) FOO)
04300		Same as DECOMPOSE but also removes the expression from FOO.  What
04400	this does is bind SOURCE to FOO, decompose SOURCE, set FOO to SOURCE, and
04500	unbind SOURCE.
04600	
04700	(SOURCETAIL)
04800		Returns SOURCE and empties it.  SOURCE may be an atom.
     

00100	The various parts of a template translate to LISP as shown:
00200	
00300	PLISP			LISP
00400	
00500	DEC → REC	(PROG (V1 V2 ...) (DEC) DEC* (REC) REC*)
00600	
00700	(x1 ... xn )	(BIND SOURCE (POP STRIP)) x1* ... xn* (UNBIND SOURCE)
00800	/C70 x		(BIND SOURCE (POP C70)) x* (UNBIND SOURCE)
00900	{ e }		(MATCH DECOMPOSE e)
01000	{ e }		(MATCH EQUAL e)  if the value of e could not be a template.
01100	{if b}		(REQUIRE b)	i.e., if b then () else fail
01200	{do s}		(EFFECT s)	i.e., s prog2 ()
01300	{x1,...,xn}	{x1}* ... {xn}*
01400	⊂x1 ... xn⊃@f	(MATCH f x1*...xn*)
01500	⊂x1 ... xn⊃	x1* ... xn*
01600	[f x1 ... xn]	(MATCH f x1*...xn*)
01700	A		(MATCH EQ (QUOTE A))
01800	:x		(POP STORE X)	first time
01900			(MATCH EQUAL X)	if already occurred outside OPT
02000	$x		(MATCH EQUAL x)
02100	<F>		(PARSE F)
02200	::X		(PARSE SHORTEST LIST) :X*
02300	→→		(ERASE THROUGH <context at beginning of rewrite>) (REC)
02400	#N		(RULE_ORDER N)
02500	.A		(SOURCETAIL) A*
02600	
02700	When templates are merged and factored, general ALTS and Atom ALTS become:
02800	
02900	a1|...|an	(ALT a1  ... an)
03000	A1 a1|...|An an	(DECATOMS (A1 a1) ... (An an))
03100	
03200	Each function has a RANK property as follows:
03300	Rank		Functions
03400	
03500	  0		SOURCETAIL
03600	  1		BIND SOURCE      MATCH EQ	DECATOMS     UNBIND SOURCE    REC
03700	  2		REQUIRE
03800	  3		PARSE
03900	  4		MATCH
04000	  5		MATCH DECOMPOSE     MATCH EQUAL
04100	  6		EFFECT
04200	  7		POP STORE
     

00100	LET FACTORER INCLUDE
00200	
00300	⊂ (PROG :V1 ::S1) (PROG :V2 ::S2) {if length(v1)>length(v2)} ⊃ →
00400		(PROG :V1 ⊂:S1 :S2⊃*)
00500	⊂ (PROG :V1 ::S1) (PROG :V2 ::S2) ⊃ → (PROG :V2 ⊂:S1 :S2⊃*)
00600	
00700	⊂ ((MATCH EQ (QUOTE :A))...) ((MATCH EQ (QUOTE :B))...) ⊃ → (DECATOMS [FAC_ATOMS (:A ...) (:B...)])
00800	⊂ ((MATCH EQ (QUOTE :A))...) ((DECATOMS ::BB)) ⊃ → (DECATOMS [FAC_ATOMS (:A ...) ::BB])
00900	⊂ ((DECATOMS ::AA)) ((MATCH EQ (QUOTE :B))...) ⊃ → (DECATOMS [FAC_ATOMS (:B ...) ::AA])
01000	⊂ ((DECATOMS ::AA)) ((DECATOMS ::BB :C)) ⊃ → ⊂ ((DECATOMS [FAC_ATOMS :C ::AA])) ((DECATOMS ::BB)) ⊃*
01100	⊂ ((DECATOMS ::AA)) ((DECATOMS)) ⊃ → (DECATOMS ::AA)
01200	
01300	⊂ :X ((ALT ::Y)) ⊃ → (ALT [FAC_ALT :X ::Y])
01400	⊂ ((ALT ::Y)) :X ⊃ → (ALT [FAC_ALT :X ::Y])
01500	⊂ ((ALT ::X)) ((ALT ::Y :Z)) ⊃ → ⊂ ((ALT [FAC_ALT :Z ::X])) ((ALT ::Y)) ⊃*
01600	⊂ ((ALT ::X)) ((ALT)) ⊃ → (ALT ::X)
01700	
01800	⊂ (:A ::AA) (:A ::BB) ⊃ → ⊂ :A ⊂:AA :BB⊃*  ⊃
01900	⊂ (:A ::AA) (:B ::BB) {if A.RANK>B.RANK}⊃ → (ALT (:A ::AA) (:B ::B))
02000	⊂ :X :Y ⊃ → (ALT :X :Y)
02100		;
02200	
02300	LET FAC_ATOMS INCLUDE
02400	
02500	⊂ (:A ::XX) (:A ::YY) ... ⊃ → [FAC_ATOMS ( :A   ⊂:XX :YY⊃@FACTORER ) ...]
02600	⊂ (:A ::XX) (:B ::YY) ... ⊃ → ⊂ (:B ::YY) [FAC_ATOMS (:A ::XX) ...] ⊃
02700	⊂ (:A ::XX) ⊃ → (:A ::XX)
02800		;
02900	
03000	LET FAC_ALT INCLUDE
03100	⊂ :A :B ... ⊃ ⊂:A :B⊃@FACTORER ≡ (ALT ...) → ⊂ :B ⊂ :A ... ⊃* ⊃
03200	⊂ :A :B ... ⊃ ⊂:A :B⊃@FACTORER ≡ :AB → ⊂ :AB ... ⊃
03300	⊂ :A ⊃ → ⊂ :A ⊃
03400		;
     

00100	LET LISP INCLUDE
00200	(BIND SOURCE (POP STRIP)) → ⊂ (TOKEN)*
00300			  (INTO LIST)@LIMP ⊃
00400	
00500	(UNBIND SOURCE) → ⊂
00600			  (OUTOF LIST)@LIMP ⊃
00700	
00800	(POP <argsfun>:M :F ::X) → (:F ::X (TOKENS :M))*
00900			   (TOKEN)*
01000			    (STORE :N) @LIMP ⊃
01100	
01200	(MATCH ::X) → (REQUIRE (POP ::X))*
01300	
01400	(PARSE ::X) → (PREFIXSOURCE (POP ::X))*
01500	
01600	(REQUIRE :X) → (COND (:X) (T (FAIL)))*
01700	
01800	(PREFIXSOURCE :X) → ⊂ :X* (PREFIXSOURCE)@LIMP ⊃
01900	
02000	(EFFECT :E) → :E*
02100	
02200	(ALT ::X) → ⊂ (ALT) @LIMP
02300			  (ALT ::X) @CONTROL ⊃
02400	
02500	(MATCH EQ (QUOTE :A)) → ⊂ (TOKEN EQ :A) @LIMP
02600			  (TOKEN)* ⊃
02700	
02800	(DECATOMS ::X) (MAKE HASH TABLE ::X)@LIMP ≡ :TAB →
02900			⊂ (TOKEN)*
03000			  (HASH INTO :TAB) @LIMP
03100			  (BH :TABLE) @LIMP
03200			  (INSERT HASH TABLE :TAB) @LIMP ⊃
03300	
03400	(TOKENS :N) → ⊂ :N* 	(TOKENS)@LIMP ⊃
03500	
03600	(LONGEST) → ⊂ (LONGEST)@LIMP ⊃
03700	
03800	(SHORTEST) → (SHORTEST) @LIMP
03900	
04000	(POP SHORTEST LIST) → (SHORTEST)*
04100	
04200	(POP LONGEST <exfn>:F) → (PASS SOURCE TO :F) @LIMP
     

00100	Note: (POP) does nothing.  Equivalent to [] in a template.
00200	      (MATCH) does nothing.  Equivalent to ⊂⊃.
00300	      (PARSE) does nothing.  Equivalent to <> (BNF's "<empty>").
00400	
00500	function token() =
00600		tokener(type(source))(source) ;  NOTE: lists are a special case!
00700	
00800	function token(src) = tokener(type(src))(src) ;
00900	
01000	function tokener(file)(src) =
01100		convert(scan(src), buffer(src)) ;
01200	
01300	function tokener(string)(src) =
01400		charlop(src) ;
01500	
01600	function tokener(:other)(src) = fail ;
01700	
01800	function sourcetail() =
01900		source prog1 source ← nil
02000	
02100	TOKEN()	JUMPGE TP, L1
02200		MOVE VAL, 0(TP)
02300		MOVE TP, 1(TP)
02400		POPJ P,
02500	
02600	   L1	JUMPE TP, FAIL
02700	
02800		LDB REG1, [POINT 12, 1, TP]
02900		PUSH P, TP
03000		PUSHJ P, @TOKENER(REG1)
03100		POPJ P,
03200	
03300	TOKENER(FILE)
03400		PUSH P, -1(P)
03500		PUSHJ P, SCAN
03600		MOVE REG1, -1(P)
03700		PUSH P, OBUF(REG1)
03800		PUSHJ P, CONVERTER(VAL)
03900		SUB P, [2,,2]
04000		JRST @1(P)
04100	
04200	TOKENER(STRING)
04300		MOVE REG1, -1(TP)
04400		SOSGE (REG1)
04500		POPJ SS,
04600		ILDB VAL, 1(REG1)
04700		HRLI VAL, CHARACTER
04800		SUB P, [2,,2]
04900		JRST @1(P)
     

00100	TYPES:		0	NIL
00200			1	LIST (but sign bit is also on)
00300			2	IDENTIFIER
00400			3	STRING
00500			etc.
00600	
00700	FUNCTION LIMP(..) =
00800	
00900	(INTO LIST) → ⊂ (JUMPG VAL FAIL) (PUSH P TP) (MOVE TP VAL) ⊃
01000	
01100	(OUTOF LIST) → ⊂ (JUMPN TP FAIL) (MOVE TP -N P) ⊃
01200	
01300	(TOKENS) → ⊂ :L (SOJL VAL :DONE) (PUSH P VAL) (TOKEN)* (EXCH VAL (P)) (JRST L) :DONE ⊃
01400	
01500	(SHORTEST) → ⊂ (PUSH SS NIL) (PUSH SS NIL)
01600			(DECDP :FIRST)*
01700			(TOKEN)@LISP
01800			(PUSH P VAL) (PUSH P NIL) (PUSHJ P, @CONS)
01900			(MOVEM VAL -N(SS)) (SKIPL -1-N(SS)) (MOVEM VAL -1-N(SS))
02000	
02100			:FIRST
02200			(MOVE VAL -1-N(SS))
02300	
02400	(PASS SOURCE TO :F) → ⊂ (PUSH P SRCFLAG) (PUSHJ P @:F) ⊃
02500	
02600	
02700	Extendable functions begin with:
02800		EXCH TP, -1(P)
02900		CAIN TP, SRCFLAG
03000		EXCH TP, -1(P)
03100	
03200	   and end with:
03300	
03400		EXCH TP, -1(P)
03500		CAIN TP, SRCFLAG
03600		MOVE TP, -1(P)
03700